COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE TFM
C00007 ENDMK
C⊗;
	SUBROUTINE TFM
CC	DOUBLE PRECISION IF0,IF00,IVX
	INTEGER PL
	COMMON/P/P(30) /PL/PL(47) /NUMP/NUMP

	COMMON NWZ /INS/INST(27)/TYP/SOS,JOUT
	1 ,LN  /ROFF/ROFF(27),RDEV(27),P1(27)
	1 /VV/LIMIT,V(1) /A/NP(27),XT(27),FRM(80),INVIS(27)
	DIMENSION IV(1),IT(30),ISC(12),IOC(9)
	COMMON J,L,CNT(27),BT,IREST,DF,DUR(27) 
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG
	1 ,VX(70),RAMP,K,KN,M,ML,CODE
	1 /C/T,NWZZ,IT3,T6,NW,TDUR,U,T2,T4,BY,
	1 KODE,NPAR,LP,TBG,AC,NPA,IBX,IDF,PM,NM,PAR,PX2,T1,RD,
	1 VIJ2
C  /C/=26
	EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
	1 (VX1,VX(1)),(IVX,RVX),(BK,LK)
	1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
	1 ,(VX5,VX(5)),(V,IV)
C********************CHANGE BA4 TO '1XA4' ************************
C******** ALSO FRM1 TO '(1XA'   ---- ETC.!!!!!!!
	DATA B1X/'1X'/,FRM1/' (1XA'/,FRM2/'4,  '/,COMMA/4H',',/,BA4/'1XA5'/
	1,BA1/'A1, '/,IF0/'   F0'/,IF10/'  F00'/,BDOL/' )'/,B2A/' 2F9.'/,
	1 B2B/'3,  '/,B9/'F9.1'/,B8/'F8.3'/,BPRN/')   '/,BLA/' '/
	1, BCOM/',   '/
CC	1,BA1/'A1, '/,IF0/'   F0'/,IF10/'  F00'/,BDOL/'$)'/,B2A/' 2F9.'/,
	DATA ISC/'  C  ',' CS  ','  D  ',' DS  ','  E  ','  F  ',
	1 ' FS  ','  G  ',' GS  ','  A  ',' AS  ','  B  '/,
	1 IOC/3956, 3888,3880,3876, 0, 2596,2600,2604, 2676/
C FUNNY NUMS IN IOC = /Z, /8, /4, /2, IBLA, *2, *4, *8, *Z   (Z=16 IN MUS5)
C  THESE APPEAR AS LAST 3 CHARS. WHEN ADDED TO ELEMENTS OF ISC ARRAY.
	EQUIVALENCE (FRM1,FRM(1)),(FRM2,FRM(2)),(FRM3,FRM(3)),(FRM4,FRM(4))

	MZ=-1
	JOUT=5
	MLX=3
	NL=2
7170	A3=B2A
	A4=B2B
	KL=5
	IF(NPA.LT.3)GO TO 2121

4170	NL=2
	DO 1121 K=MLX,ML
	X=P(K)
	L=PL(K)
	IF(L-2)321,521,621
C  L=1 NUMBS,  =2 NOTES,FUNCS,  =3 LITS.
321	IF(X.GE.0)GO TO 4211
	FRM(KL)=COMMA
	NL=NL+1
	KL=KL+1
4211	FRM(KL)=B8
	IF(ABS(X).GE.1000.0)FRM(KL)=B9
	FRM(KL+1)=BCOM
	KL=KL+1
	NL=NL+1
421	VX(KL-NL)=X
	GO TO 1121
521	LN=X
	IF(LN.LT.200)GO TO 2621
	LN=LN-200
	IF(LN.LT.10)IVX=IF0+LN*2
	IF(LN.GE.10)IVX=IF10 + 256*(LN/10) + 2*MOD(LN,10)
C FOR FUNC NUMS. CAN NOW BE F0→F99.  (RVX AND RVX ARE EQUIV.)
	GO TO 1621
2621	KA=LN-1
	IOCT=1+KA/12
	LN=MOD(KA,12)+1
	IVX=ISC(LN)+IOC(IOCT)
1621	VX(KL-NL)=RVX
	GO TO 42
621	IF(L.GT.3)GO TO 721
	VX(KL-NL)=X
C ABOVE LETS A4 WD BE USED IN SUBR BY SETTING IPL(N)=3.
42	FRM(KL)=BA4
	KL=KL+1
	NL=NL+1
	FRM(KL)=BCOM
C   CREATES '1XA4,'
	GO TO 1121
721	LN=X
	FRM(KL)=B1X
	NL=NL+1
	DO 821 M=1,LN-L+1
C FOR 'LIT' STRINGS
	KL=KL+1
	VX(KL-NL)=V(L-1+M)
821	FRM(KL)=BA1
1121	KL=KL+1

C  NO MORE THAN 80 ITEMS IN FORMAT.
2121	IF(KL.LE.80)GO TO 21211
21212	FORMAT(' ERROR! TOO MANY LIT. ITEMS')
	TYPE 21212
21211	DO 921 M=KL+1,80
921 	FRM(M)=BLA
	FRM(KL)=BPRN

1921	L=KL-NL-1
	IF(MX)WRITE(1,A)LK,(VX(K),K=1,L)
	IF(MZ.GE.0)GO TO 3023 
	IF(ML.GE.NPA)FRM(KL)=BDOL
	WRITE(JOUT,FRM),LK,(VX(K),K=1,L)
3023 	IF(ML.GE.NPA)GO TO 3021
	MLX=ML+1
	ML=ML+10
	IF(ML.GT.NPA)ML=NPA
	BK=BLA
CC	GO TO 3029 
	KL=3
	GO TO 4170
3021	IF(IEND)RETURN
CC3021	IF(IEND)GO TO 3011
	END